home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1994 November / macformat-018.iso / Utility Spectacular / Text / Emacs-1.12d folder / lisp / textures.el < prev    next >
Encoding:
Text File  |  1993-12-29  |  6.2 KB  |  186 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; Code to send Apple events to Textures
  3. ;;; Copyright (C) 1993 Marc Parmet.  All rights reserved.
  4. ;;;
  5. ;;; Put an alias to Textures called "Textures" in the etc folder
  6. ;;; of Emacs to enable launches.
  7. ;;;
  8.  
  9. (require 'mac-runtime "mac/runtime")
  10.  
  11. (defvar textures:switch t "Set to non-nil to have Emacs bring Textures to the front after sending it an Apple event.")
  12.  
  13. (defmacro textures:create-apple-event (eventClass eventID event transactionID)
  14.   (list 'ae-create-apple-event "*TEX" eventClass eventID event transactionID))
  15.  
  16. (defun textures:launch ()
  17.   "Launch Textures.  There should be an alias to Textures in ~/etc."
  18.   (launch-application "Textures"))
  19.  
  20. (defun textures:send-event-internal (event)
  21.   (let ((reply (make-string sizeof-AppleEvent 0)))
  22.     (AESend event reply (+ kAEQueueReply kAENeverInteract) kAENormalPriority 0 0 0)))
  23.  
  24. (defun textures:need-alias-message ()
  25.   (message "Put an alias to Textures named “Textures” in the etc folder of Emacs."))
  26.  
  27. (defun textures:send-event (event)
  28.   (let ((err (textures:send-event-internal event)))
  29.     (cond
  30.      ((= err noErr)
  31.       (if textures:switch
  32.           (textures:launch))
  33.       noErr)
  34.      ((= err connectionInvalid)
  35.       (if (y-or-n-p "Textures is not running.  Try to launch? ")
  36.           (let ((launch-err (textures:launch)))
  37.             (cond
  38.              ((= launch-err fnfErr)
  39.               (textures:need-alias-message)
  40.               noErr)
  41.              (t
  42.               (sleep-for 5) ;;; Let the Finder do the launch before resending
  43.               (let ((err (textures:send-event-internal event)))
  44.                 (if (= err connectionInvalid)
  45.                     (progn
  46.                       (message "Couldn't launch Textures")
  47.                       noErr)
  48.                   err)))))
  49.         noErr))
  50.      (t
  51.       err))))
  52.  
  53. (defun textures:open-or-print-file (file command)
  54.   (let* (event
  55.          transactionID
  56.          (result
  57.           (catch 'bailout
  58.             (catch-err (textures:create-apple-event kCoreEventClass command
  59.                                                     event transactionID))
  60.             (catch-err (unix-filename-to-FSSpec file spec))
  61.             (catch-err (AEPutParamPtr event keyDirectObject typeFSS spec (length spec)))
  62.             (setq ae-history (cons (cons transactionID
  63.                                          (list
  64.                                           (cons 'description
  65.                                                 (concat
  66.                                                  (if (equal command kAEOpenDocuments)
  67.                                                      "textures-open "
  68.                                                    "textures-print ")
  69.                                                  file))
  70.                                           (cons 'handler 'do-simple-reply)))
  71.                                    ae-history))
  72.             (catch-err (textures:send-event event))
  73.             noErr)))
  74.     (if event (AEDisposeDesc event))
  75.     result))
  76.  
  77. (defun textures:open-file (file)
  78.   "Send an open-document event to Textures."
  79.   (textures:open-or-print-file file kAEOpenDocuments))
  80.  
  81. (defun textures:print-file (file)
  82.   "Send an print-document event to Textures."
  83.   (textures:open-or-print-file file kAEPrintDocuments))
  84.  
  85. (defun textures:typeset-text (text)
  86.   "Send the given string to Textures to be typeset."
  87.   (let* (event
  88.          transactionID
  89.          (result
  90.           (catch 'bailout
  91.             (catch-err (textures:create-apple-event kAEMiscStandards kAEDoScript
  92.                                                     event transactionID))
  93.             (catch-err (AEPutParamPtr event keyDirectObject typeChar
  94.                                       text (length text)))
  95.             (setq ae-history (cons (cons transactionID
  96.                                          (list
  97.                                           (cons 'description "typeset-text")
  98.                                           (cons 'handler 'do-simple-reply)))
  99.                                    ae-history))
  100.             (catch-err (textures:send-event event))
  101.             noErr)))
  102.     (if event (AEDisposeDesc event))
  103.     result))
  104.  
  105. (defun textures:typeset-file (file)
  106.   "Send the given filename to Textures to be typeset."
  107.   (let* (event
  108.          spec
  109.          transactionID
  110.          (result
  111.           (catch 'bailout
  112.             (catch-err (textures:create-apple-event kAEMiscStandards kAEDoScript
  113.                                                     event transactionID))
  114.             (catch-err (unix-filename-to-FSSpec file spec))
  115.             (catch-err (AEPutParamPtr event keyDirectObject typeFSS spec
  116.                                       (length spec)))
  117.             (setq ae-history (cons (cons transactionID
  118.                                          (list
  119.                                           (cons 'description (concat "typeset-file " file))
  120.                                           (cons 'handler 'do-simple-reply)))
  121.                                    ae-history))
  122.             (catch-err (textures:send-event event))
  123.             noErr)))
  124.     (if event (AEDisposeDesc event))
  125.     result))
  126.  
  127. (defun textures:menu-open-or-print-file (command)
  128.   (let ((file (call-interactively (function (lambda (x)
  129.                                               (interactive "fFile to open: ") x)))))
  130.     (if file
  131.         (let ((err (textures:open-or-print-file file command)))
  132.           (if err (report-error-in-message-line err))))))
  133.  
  134. (defun textures:menu-open-file (menu item)
  135.   (textures:menu-open-or-print-file kAEOpenDocuments))
  136.  
  137. (defun textures:menu-print-file (menu item)
  138.   (textures:menu-open-or-print-file kAEPrintDocuments))
  139.  
  140. (defun textures:menu-typeset-buffer (menu item)
  141.   (if (and (not (eq major-mode 'plain-tex-mode))
  142.        (not (eq major-mode 'latex-mode)))
  143.       (tex-mode))
  144.   (TeX-buffer))
  145.  
  146. (defun textures:menu-typeset-region (menu item)
  147.   (TeX-region (point) (mark)))
  148.  
  149. (defun textures:menu-typeset-file (menu item)
  150.   (let* ((file (call-interactively (function (lambda (x)
  151.                                                (interactive "fFile to typeset: ")
  152.                                                x))))
  153.          (err (textures:typeset-file (expand-file-name file))))
  154.     (report-error-in-message-line err)))
  155.  
  156. (defun textures:menu-launch (menu item)
  157.   (let ((err (textures:launch)))
  158.     (if (= err fnfErr)
  159.         (textures:need-alias-message)
  160.       (report-error-in-message-line err))))
  161.  
  162. (defun textures:menu-switch (menu item)
  163.   (setq textures:switch (not textures:switch))
  164.   (CheckItem textures:menu 5 (if textures:switch 1 0))
  165.   (if (and textures:switch (not (file-exists-p "/bin/Textures")))
  166.       (textures:need-alias-message)))
  167.  
  168. (defvar textures:have-menu nil)
  169.  
  170. (if (not textures:have-menu)
  171.     (progn
  172.       (defvar textures:menu (NewMenu 136 "Typeset"))
  173.       (AppendMenu textures:menu "Launch Textures" 'textures:menu-launch)
  174.       (AppendMenu textures:menu "Open file in Textures..." 'textures:menu-open-file)
  175.       (AppendMenu textures:menu "Print file in Textures..." 'textures:menu-print-file)
  176.       (AppendMenu textures:menu "(-" nil)
  177.       (AppendMenu textures:menu "Switch after sending command" 'textures:menu-switch)
  178.       (AppendMenu textures:menu "(-" nil)
  179.       (AppendMenu textures:menu "Typeset file..." 'textures:menu-typeset-file)
  180.       (AppendMenu textures:menu "Typeset buffer/T" 'textures:menu-typeset-buffer)
  181.       (AppendMenu textures:menu "Typeset region" 'textures:menu-typeset-region)
  182.       (InsertMenu textures:menu 0)
  183.       (CheckItem textures:menu 5 textures:switch)
  184.       (DrawMenuBar)
  185.       (setq textures:have-menu t)))
  186.